home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / Browser-improvements.st < prev    next >
Text File  |  1993-07-24  |  5KB  |  118 lines
  1. "    NAME        Browser-improvements
  2.     AUTHOR        knight@mrco.carleton.ca (Alan Knight) and mario@cs.man.ac.uk (Mario Wolczko)
  3.     FUNCTION    New/improved features for opening browsers
  4.     ST-VERSION    4.1
  5.     PREREQUISITES    
  6.     CONFLICTS    Browser>pickAClass:, Browser>selectorMenu
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE         17 Oct 1991
  10. SUMMARY
  11. Here are a couple of minor improvements for ParcPlace Smalltalk
  12. Release 4.1.  The first allows you to spawn a class/hierarchy browser from a
  13. message list browser, letting you easily browse a class that occurs in
  14. a senders or implementors list.  The second improves the 'find class'
  15. feature, mostly by not requiring the trailing wildcard.  Both are
  16. modified by me from the standard system distribution, the second with
  17. improvements suggested by Danny Epstein.  (Ported to 4.1 by Mario Wolczko;
  18. also added spawn of hierarchy browser.)
  19.  
  20. Alan Knight  knight@mrco.carleton.ca  +1 613 788 2600x5783   Support
  21. Dept. of Mechanical and Aeronautical Engineering             the
  22. Carleton University, Ottawa, Ontario, Canada, K1S 5B6        LPF
  23.  
  24. Mario Wolczko
  25. Dept. of Computer Science   Internet:      mario@cs.man.ac.uk
  26. The University              uucp:    mcsun!!uknet!!man.cs!!mario
  27. Manchester M13 9PL          JANET:         mario@uk.ac.man.cs
  28. U.K.                        Tel: +44-61-275 6146  (FAX: 6236)
  29. "
  30. 'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 9 November 1992 at 6:45:08 pm'!
  31.  
  32.  
  33.  
  34. !Browser methodsFor: 'selector list'!
  35.  
  36. selectorMenu
  37.     "Answer a Menu of operations on message selectors to be 
  38.     displayed when the operate menu button is pressed."
  39.  
  40.     "Browser flushMenus"
  41.     selector == nil ifTrue: [^ nil].
  42.     MessageMenu == nil ifTrue:
  43.         [MessageMenu := PopUpMenu
  44.             labels: 'file out as...\hardcopy\spawn\senders\implementors\messages...\move to...\remove...' withCRs
  45.             lines: #(3 6)
  46.             values: #(fileOutMessage printOutMessage spawnMethod browseSenders browseImplementors browseMessages moveMethod removeMethod).
  47.         MessageMenu valueAt: 3 put: (PopUpMenu
  48.             labels: 'method\class\hierarchy' withCRs
  49.             values: #(spawnMethod spawnClass spawnHierarchy))].
  50.     ^ MessageMenu! !
  51.  
  52. !Browser methodsFor: 'private-category functions'!
  53.  
  54. pickAClass: prompt    
  55.     "Choose a class with a prompter.  Bring up menu for wildcards.
  56.     Answer the an empty string if that's what the user returned or
  57.     if the user selects outside the menu, answer nil if the user picks
  58.     a name that does not match any class name.
  59.     Modified from the standard distribution to bring up
  60.     a menu for any ambiguous string which does not completely specify a class.
  61.     i.e.  'obj'  gives a menu of (Object ObjectMemory)
  62.     but  'object' will bring you immediately to the class
  63.     Object."
  64.  
  65.     | destClassName destClass namesToSearch |
  66.     destClassName := DialogView request: prompt initialAnswer: ParagraphEditor currentSelection. 
  67.     destClassName = '' ifTrue: [^''].
  68.  
  69.     "Allow finding the classes for global variables only if there are no wildcards at all.  This
  70.     minimizes e.g. unexpectedly getting SystemDictionary when expecting SmalltalkCompiler "
  71.     namesToSearch := Smalltalk perform:
  72.         ((destClassName includes: $*) ifTrue: [#classNames] ifFalse: [#keys]).
  73.  
  74.     "Make two passes, the first time with an exact search, possibly allowing globals.  If the 
  75.     first pass finds an exact match, then return it, otherwise add a wildcard onto the end and
  76.     try again"
  77.     2 timesRepeat:
  78.         [| classes actualClassName |
  79.         Cursor execute showWhile:
  80.             [classes := namesToSearch select: [:cn | destClassName match: cn]].
  81.         classes size = 1
  82.             ifTrue: [actualClassName := classes detect: [:someItem | true]].  "Set>any not in base image."
  83.         classes size > 1
  84.             ifTrue:
  85.                 [|chosenSelector|
  86.                    (chosenSelector := 
  87.                     (PopUpMenu labelList: (Array with: classes)) startUp) = 0
  88.                         ifTrue: [^'']
  89.                         ifFalse: [actualClassName := classes at: chosenSelector]].
  90.         actualClassName isNil
  91.             ifFalse:
  92.                 [destClass := Smalltalk at: actualClassName asSymbol ifAbsent: [^nil].
  93.                 meta ifTrue: [destClass := destClass class].
  94.                 ^destClass].
  95.         destClassName := destClassName , '*'.
  96.         namesToSearch := Smalltalk classNames].  "Second time through, no globals allowed"
  97.  
  98.     ^nil! !
  99.  
  100.  
  101. !HierarchyBrowser class methodsFor: 'view creation'!
  102.  
  103. newPickClass
  104.     "Ask the user to name a class, then create and schedule a view
  105.     that is a browser for that class's hierarchy."
  106.     "HierarchyBrowser newPickClass"
  107.  
  108.     | browser class |
  109.  
  110.     class := (browser := Browser new meta: false) pickAClass: 'Browse what class?'.
  111.     class = '' ifTrue: [^self].
  112.     class isNil ifTrue:
  113.         [DialogView warn: 'No matching class'. ^self].
  114.     class isBehavior ifFalse: [class := class class].
  115.     class isMeta ifTrue: [class := class soleInstance].
  116.     ^HierarchyBrowser openHierarchyBrowserFrom: (browser onClass: class)! !
  117.  
  118.